home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel-075.lha / feel0.75 / Src / structs.h < prev    next >
C/C++ Source or Header  |  1992-06-18  |  15KB  |  602 lines
  1. /* ******************************************************************** */
  2. /*  structs.h        Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Basic definitions of tags and structures                             */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * Change Log:
  9.  *   Version 1, April 1989
  10.  *   added a little support for classes RJB
  11.  *   hacked it about a bit KJP
  12.  *   added semaphores KJP
  13.  */
  14.  
  15. #ifndef STRUCTS_H
  16. #define STRUCTS_H
  17.  
  18. #include <stdio.h>
  19.  
  20. #ifdef WITH_BIGNUMS
  21. #include "BigZ.h"
  22. #endif
  23. #undef BIGNUM
  24.  
  25. #ifndef SETJMP_H
  26. #define SETJMP_H
  27. #include <setjmp.h>
  28. #endif
  29.  
  30. /* Load system types... */
  31.  
  32. #include "system_t.h"
  33.  
  34. /*#include "compact.h"*/
  35. /* Primitive types... */
  36.  
  37. /* indiacte that ob can be swept */
  38. /* note that the bignum typeof operation may need to be changed 
  39.    plus some comparisons in arith.c --- unless we do them right
  40.    --- pab */
  41.  
  42. #define CALLABLE_TYPE 0x100
  43. #define MACRO_TYPE    0x200
  44. #define STATIC_TYPE   0x400
  45.  
  46. #define TYPE_UNUSED     -1
  47.  
  48. #define TYPE_ENV    0xe0
  49.  
  50. #define TYPE_CONS    0x1
  51. #define TYPE_CHAR    (0x2)
  52. #define TYPE_STRING    (0x3)
  53. #define TYPE_TABLE    (0x5)
  54. #define TYPE_SYMBOL     (0x6)
  55. #define TYPE_THREAD    (0xb)
  56. #define TYPE_STREAM    (0xc)
  57. #define TYPE_CLASS    (0xd)
  58. #define TYPE_INSTANCE    (0xe)
  59. #define TYPE_SPECIAL    (0xf)
  60. #define TYPE_VECTOR    0x10
  61.  
  62. #define TYPE_INT    (0x11)
  63. #define TYPE_RATIONAL    (0x14)
  64. #define TYPE_FLOAT    (0x15)
  65. #define TYPE_COMPLEX    (0x16)
  66. #define TYPE_BIGNUM     (0x17)
  67. #define TYPE_LASTNUMBER 0x2f
  68.  
  69. #define TYPE_CONTINUE    (0x30)
  70.  
  71. #define TYPE_C_MODULE   (0x40)
  72. #define TYPE_I_MODULE   (0x50)
  73. #define TYPE_C_FUNCTION (0x60 | 0x100)
  74. #define TYPE_I_FUNCTION (0x61 | 0x100)
  75. #define TYPE_METHOD     0x62
  76. #define TYPE_GENERIC    (0x63 | 0x100)
  77.  
  78. #define TYPE_C_MACRO    (0x70 | 0x200)
  79. #define TYPE_I_MACRO    (0x71 | 0x200)
  80.  
  81. #define TYPE_SEMAPHORE  (0x90)
  82. #define TYPE_LISTENER   (0xa0)
  83. #define TYPE_SOCKET     (0xa1)
  84. #define TYPE_NULL       (0xb0)
  85. #define TYPE_WEAK_WRAPPER 0xc0
  86.  
  87. #define TYPE_B_FUNCTION (0x7a | 0x100)
  88. #define TYPE_B_MACRO    (0x7b | 0x200)
  89. /* Primitive accessors... */
  90. #ifdef NOLOWTAGINTS
  91. #define typeof(p)      ((p)->OBJECT.header.type)
  92. #define classof(p)      ((p)->OBJECT.header.class)
  93. #else
  94. #define typeof(p)       (((int)p) & 1 ? TYPE_INT: ((p)->OBJECT.header.type))
  95. #define classof(p)     (((int)p) & 1 ? Integer: ((p)->OBJECT.header.class))
  96. #endif
  97. #define type_of(p)      typeof(p)
  98. #define gcof(p)         (((p)->OBJECT).header.gc)
  99. #define gc_of(p)        gcof(p)
  100. #define lval_classof(p)  ((p)->OBJECT.header.class)
  101. #define lval_typeof(p)   ((p)->OBJECT.header.type)
  102.  
  103. #define class_of(p)     classof(p)
  104.  
  105. /* Primitive type testers... */
  106.  
  107. #define is_cons(p)      (typeof(p) == TYPE_CONS)
  108. #define is_char(p)      (typeof(p) == TYPE_CHAR)
  109. #define is_string(p)    (typeof(p) == TYPE_STRING)
  110. #define is_table(p)     (typeof(p) == TYPE_TABLE)
  111. #define is_symbol(p)    (typeof(p) == TYPE_SYMBOL)
  112. #define is_function(p)  (typeof(p) & CALLABLE_TYPE)
  113. #define is_macro(p)     (typeof(p) & MACRO_TYPE)
  114. #define is_static(p)    (typeof(p) & STATIC_TYPE)
  115. #define is_module(p)    ((typeof(p) == TYPE_I_MODULE)  | \
  116.              (typeof(p) == TYPE_C_MODULE))
  117. #define is_special(p)   (typeof(p) == TYPE_SPECIAL)
  118. #define is_thread(p)    (typeof(p) == TYPE_THREAD)
  119. #define is_stream(p)    (typeof(p) == TYPE_STREAM)
  120. #ifdef NOLOWTAGINTS
  121. #define is_fixnum(p)    (typeof(p) == TYPE_INT)
  122. #else
  123. #define is_fixnum(p)    (((int) (p)) &1)
  124. #define mk_fixnum(x)     ((LispObject) (((x)<<1) | 1))
  125. #endif
  126.  
  127. #define is_bignum(p)    (typeof(p) == TYPE_BIGNUM)
  128. #define is_float(p)     (typeof(p) == TYPE_FLOAT)
  129. #define is_vector(p)    ((typeof(p)&TYPE_VECTOR) == TYPE_VECTOR)
  130. #define is_continue(p)    (typeof(p) == TYPE_CONTINUE)
  131.  
  132.  
  133.  
  134. #define is_c_function(p) (typeof(p) == TYPE_C_FUNCTION)
  135. #define is_c_module(p)  (typeof(p) == TYPE_C_MODULE)
  136. #define is_i_function(p) (typeof(p) == TYPE_I_FUNCTION)
  137. #define is_i_module(p)  (typeof(p) == TYPE_I_MODULE)
  138. #define is_c_macro(p)   (typeof(p) == TYPE_C_MACRO)
  139. #define is_i_macro(p)   (typeof(p) == TYPE_I_MACRO)
  140. #define is_b_function(p) (typeof(p)==TYPE_B_FUNCTION)
  141. #define is_b_macro(p)    (typeof(p) == TYPE_B_MACRO)
  142.  
  143. #define is_semaphore(p) (typeof(p) == TYPE_SEMAPHORE)
  144. #define is_listener(p)  (typeof(p) == TYPE_LISTENER)
  145. #define is_socket(p)    (typeof(p) == TYPE_SOCKET)
  146. #define is_weak_wrapper(p) (typeof(p) == TYPE_WEAK_WRAPPER)
  147.  
  148. #define is_e_function(p) (0)
  149. #define is_e_macro(p) (0)
  150.  
  151. /* Other macros... */
  152.  
  153. #define null(p)      ((LispObject)(p) == nil)
  154. #define consp(p)     (is_cons(p) && (p) != nil)
  155. #define symbolp(p)   (is_symbol(p) || (p) == nil)
  156. #define CAR(p)         (((p)->CONS).car)
  157. #define CDR(p)         (((p)->CONS).cdr)
  158. #define classp(p)    (typeof(p) & 0x2000)
  159. #define is_number(p) (typeof(p) >= TYPE_INT && typeof(p) <= TYPE_LASTNUMBER)
  160.  
  161. typedef union lispunion *LispObject;
  162.  
  163. /* GC used object... */
  164.  
  165. struct hunk_structure {
  166.   short        type;
  167.   short        gc;
  168.   LispObject   next_hunk;
  169.   int          hunk_size;
  170. };
  171.  
  172. typedef struct Object_struct
  173. {
  174.   short type;
  175.   short gc;
  176.   LispObject class;
  177. } Object_t;
  178.  
  179. struct envobject {
  180.   Object_t        header;
  181.   LispObject        variable;
  182.   LispObject        value;
  183.   struct envobject *    next;
  184.   LispObject        mutable;
  185. };
  186.  
  187. typedef struct envobject *Env;
  188.  
  189. /* the top most class object */
  190.  
  191. struct object_structure {
  192.   Object_t    header;
  193.   LispObject    slots[1];    /* the other slots */
  194. };
  195.  
  196.  
  197. struct integer_structure {
  198.   Object_t     header;
  199.   int        value_part;
  200. };
  201. #ifdef NOLOWTAGINTS
  202. #define intval(x) ((x)->INT.value_part)
  203. #else
  204. #define intval(x) (((int)x)>>1)
  205. #endif
  206.  
  207. /* low tag ints */
  208.  
  209.  
  210.  
  211. struct float_structure {
  212.   Object_t     header;
  213.   double    fvalue;
  214. };
  215.  
  216. struct bignum_structure {
  217. Object_t header;
  218. #ifdef WITH_BIGNUMS
  219.   BigZ          value;
  220. #endif
  221.  
  222.   int *         bnum;
  223. };
  224.  
  225. struct complex_structure {
  226.   Object_t header;
  227.   LispObject    real;
  228.   LispObject    imaginary;
  229. };
  230.  
  231. struct ratio_structure {
  232.   Object_t header;
  233.   LispObject    numerator;
  234.   LispObject    denominator;
  235. };
  236.  
  237. struct character_structure {
  238.   Object_t header; 
  239.   unsigned char    font;
  240.   unsigned char    code;
  241. };
  242.  
  243. struct symbol_structure {
  244.   Object_t    header;
  245.   int         hash;      /* hash value cache */
  246.   LispObject    lmodule;  /* Module lookup cache for the interpreter */
  247.   LispObject    lvalue;   /* Part II */
  248.   LispObject    gvalue;   /* Dynamic global value */
  249.   LispObject    plist;
  250.   LispObject    pname;
  251.  
  252.   LispObject left;
  253.   LispObject right;
  254. };
  255.  
  256. /* comparator is a equality function, defaulting to Fn_equal,
  257.  * returning t or nil.
  258.  */
  259.  
  260. struct table_structure {
  261.   Object_t header; 
  262.   LispObject    (*comparator)(LispObject*);
  263.   LispObject    lisp_comparator;
  264.   LispObject    tree;
  265. };
  266.  
  267. /* This one is an internal type, used by tables and arrays.
  268.  * "base" is the first element in the array -- the others follow
  269.  * on directly --- note that this comment is carp (anag)
  270.  */
  271.  
  272.  
  273. #ifdef notdef /* Thu Oct 17 14:49:31 1991 */
  274. /**/
  275. /**/#define vref(v,n)  (*((v)->VECTOR.base + (n)))
  276. /**/#define vrefupdate(v,n,obj) (vref(v,n)=obj)
  277. #endif /* notdef Thu Oct 17 14:49:31 1991 */
  278.  
  279. #define vref(v,n) (*(&((v)->VECTOR.base) + (n)))
  280. #define vrefupdate(v,n,obj) (vref(v,n)=(obj))
  281. struct vector_structure {
  282.   Object_t header;
  283.   int length;            /* for now */
  284.   LispObject base;           
  285. };
  286.  
  287. #ifdef WITH_SMALL_CONSES
  288. struct cons_structure {
  289.   short        type;
  290.   short        gc;
  291.   LispObject    car;
  292.   LispObject    cdr;
  293. };
  294. #else
  295. struct cons_structure {
  296.   Object_t header;
  297.   LispObject    car;
  298.   LispObject    cdr;
  299. };
  300. #endif
  301.  
  302.  
  303. struct stream_structure {
  304.   Object_t header;
  305.   FILE*        handle;
  306.   LispObject    name;
  307.   int        curchar;
  308.   int        mode;
  309. };
  310.  
  311. struct string_structure {
  312.   Object_t header;
  313.   int length;
  314.   char value; /* really a c-string --- Should these be CHARs ?? */
  315. };
  316.  
  317. #define stringof(x)\
  318.   (&((x)->STRING.value))
  319.  
  320. struct funcallable_object_structure {
  321.   Object_t header;
  322.  
  323.   LispObject    (*cfun)();
  324.   LispObject    cfun_arg;
  325. };
  326.  
  327. struct continue_structure {
  328.   Object_t header;
  329.  
  330.   LispObject    value;     /* Returned with... */
  331.   LispObject    target;    /* When bouncing unwind protects... */
  332.  
  333.   LispObject    thread;
  334.  
  335.   LispObject  *gc_stack_pointer; /* Interpreter state */
  336.   Env           dynamic_env;
  337.   LispObject    last_continue;
  338.   LispObject    handler_stack;
  339.  
  340.   LispObject    dp;  /* Elvira state */
  341.  
  342.   /* Bytecode state? */
  343.  
  344.   jmp_buf       machine_state;
  345.  
  346.   int           live;
  347.   int           unwind;
  348.  
  349. };
  350.  
  351. struct thread_structure {
  352.   Object_t header;
  353.  
  354.   LispObject*  gc_stack_base;
  355.   
  356.  
  357.   LispObject     state;
  358.  
  359.   LispObject    fun;
  360.   LispObject    args;
  361.   LispObject    value;
  362.  
  363.   LispObject    parent;
  364.   LispObject    cochain;
  365.   int           status;
  366.   int           stack_size;
  367.   int           gc_stack_size;
  368.   int*          stack_base;
  369.  
  370. };
  371.  
  372. struct semaphore_structure {
  373.   Object_t header;
  374.   SystemSemaphore semaphore; /* Just a hacked wrapper */
  375. };
  376.  
  377. struct class_structure {
  378.   Object_t header;
  379.   int           local_count;   /* Number of local slots */
  380.  
  381.   LispObject    name;           /* Name of the class (NOT binding name) */
  382.   LispObject    superclasses;  /* Direct parents */
  383.   LispObject    subclasses;    /* Direct subclasses */
  384.   LispObject    slot_table;    /* Table of slot descriptions */
  385.   LispObject    slot_list;     /* Slot list */
  386.   LispObject    direct_slot_list; /* Direct slot list */
  387.   LispObject    precedence;    /* Class precedence list */
  388. #ifdef notdef /* Thu Oct 17 14:50:09 1991 */
  389. /**/  LispObject    prototype;     /* Prototypical instance */ *
  390. #endif /* notdef Thu Oct 17 14:50:09 1991 */
  391.  
  392. };
  393.  
  394. #define slotref(v,n)  (*(&((v)->INSTANCE.slots) + (n)))
  395. #define slotrefupdate(v,n,obj) (slotref(v,n)=obj)
  396.  
  397. struct instance_structure {
  398.   Object_t    header;
  399.   LispObject    slots;        /* Some structure of data */
  400. };
  401.  
  402.  
  403. /* Functions... */
  404.  
  405. /* Special forms are compiler only and don't have homes (?) */
  406.  
  407. struct special_structure {
  408.   Object_t header;
  409.   LispObject    name;
  410.   Env           env;
  411.   LispObject    (*func)();
  412. };
  413.  
  414. /* Basic function template to which all conform */
  415.  
  416. struct function_structure {
  417.   Object_t     header;
  418.   LispObject    name;      /* Original name in their module of origin */
  419.   LispObject    home;      /* Module of origin */
  420.   Env        env;       /* Defining parameter environment */
  421.   int        argtype;   /* Argument type code - unique for args */
  422. };
  423.  
  424. struct c_function_structure {
  425.   Object_t      header;
  426.   LispObject  name;
  427.   LispObject  home;
  428.   Env         env;
  429.  
  430.   int         argtype;
  431.   LispObject  (*func)();   /* Compiled functions just need fun pointer */
  432. };
  433.  
  434. struct i_function_structure {
  435.   Object_t    header;
  436.   LispObject    name;
  437.   LispObject    home;  
  438.   Env        env;
  439.  
  440.   int        argtype;    
  441.   LispObject    bvl;        /* Parameter list */
  442.   LispObject    body;           /* Body forms */
  443. };
  444.  
  445. /* Macros are a logical entity - being just specially interpretted functions */
  446.  
  447. struct generic_structure {   
  448.   Object_t     header;
  449.  
  450.   LispObject    name;
  451.   LispObject    home;
  452.   Env           env;           /* Redundant, I think */
  453.   int           argtype;
  454.  
  455.   LispObject    method_class;
  456.   LispObject    discriminator;
  457.   LispObject    cache_table;
  458.   LispObject    method_table;  /* Like it says */
  459. };
  460.  
  461. /* Methods AREN'T FUNCTIONS ! */
  462.  
  463. struct method_structure {
  464.   Object_t header;
  465.  
  466.   LispObject    qualifier;     /* Whatever that may be */
  467.   LispObject    signature;     /* Class list up to any n-ary bit */
  468.   LispObject    host;          /* Generic function ( nil => unatached ) */
  469.   LispObject    function;      /* The actual function */
  470.   LispObject           fixed;         /* Detatchable or not */
  471. };
  472.  
  473. /* Module structures */
  474.  
  475. /* Template for all types - an abstract class like function */
  476.  
  477. struct module_structure {
  478.   Object_t      header;
  479.   LispObject  name;              /* Symbol */
  480.   LispObject  home;              /* In ? */
  481.   LispObject  imported_modules;  /* Module dependecies - name list */
  482.   LispObject  exported_names;    /* Name list too */
  483.   LispObject  bindings;
  484. };
  485.  
  486. struct c_module_structure {
  487.   Object_t    header;
  488.   LispObject  name;
  489.   LispObject  home;
  490.   LispObject  imported_modules;
  491.   LispObject  exported_names;
  492.   LispObject  bindings;
  493.   
  494.   LispObject  values;            /* Value vector of static module */
  495.   LispObject  entry_count;
  496.   LispObject  (**functions)();   /* Function vector */
  497. };
  498.  
  499. typedef struct c_module_structure MODULE;
  500.  
  501. struct i_module_structure {
  502.   Object_t     header;
  503.   LispObject   name;
  504.   LispObject   home;
  505.   LispObject   imported_modules;      
  506.   LispObject   exported_names;        
  507.   LispObject   bindings;
  508.  
  509.   int          bounce_flag;
  510. };
  511.  
  512. /* Sockets support... */
  513.  
  514. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  515.  
  516. #include "syssockets.h"
  517.  
  518. struct listener_structure {
  519.   Object_t header;
  520.   
  521.   SocketHandle   socket;
  522.   SocketInName   name;
  523.  
  524.   int            state;
  525. };
  526.  
  527. struct socket_structure {
  528.   Object_t      header;
  529.  
  530.   SocketHandle   socket;
  531.   SocketInName   name;
  532.  
  533.   char           buffer[SOCKET_BUFFER_SIZE]; /* Input buffer */
  534.  
  535.   int            state;
  536. };
  537.  
  538. #endif
  539.  
  540. /* Structure for extensiblility without hacking... */
  541.  
  542. struct c_object_structure {
  543.   Object_t header;
  544.  
  545.   LispObject  *slots;        /* LispObject slot vector - garbage protected */
  546.   char        first_c_byte; /* Start of C-data, unprotected */
  547. };
  548.  
  549. /* Weak wrappers... */
  550.  
  551. struct weak_wrapper_structure {
  552.   Object_t header;
  553.   LispObject  object;
  554. };
  555.  
  556. union lispunion {
  557.   struct hunk_structure         HUNK;
  558.   struct object_structure    OBJECT;
  559.   struct integer_structure    INT;
  560.   struct float_structure    FLOAT;
  561.   struct bignum_structure    BIGNUM;
  562.   struct complex_structure    COMPLEX;
  563.   struct ratio_structure    RATIO;
  564.   struct character_structure    CHAR;
  565.   struct symbol_structure    SYMBOL;
  566.   struct table_structure    TABLE;
  567.   struct cons_structure        CONS;
  568.   struct stream_structure    STREAM;
  569.   struct string_structure       STRING;
  570.   struct thread_structure       THREAD;
  571.   struct semaphore_structure    SEMAPHORE;
  572.   struct class_structure    CLASS;
  573.   struct instance_structure    INSTANCE;
  574.   struct vector_structure       VECTOR;
  575.   struct continue_structure    CONTINUE;
  576.   struct envobject        ENV;
  577.   struct special_structure      SPECIAL;
  578.   struct function_structure     FUNCTION;
  579.   struct c_function_structure   C_FUNCTION;
  580.   struct i_function_structure   I_FUNCTION;
  581. /**  struct generic_structure      GENERIC; */
  582.   struct function_structure     MACRO;
  583.   struct c_function_structure   C_MACRO;
  584.   struct i_function_structure   I_MACRO;
  585. /**   struct method_structure       METHOD; */
  586.   struct module_structure       MODULE;
  587.   struct c_module_structure     C_MODULE;
  588.   struct i_module_structure     I_MODULE;
  589. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  590.   struct listener_structure     LISTENER;
  591.   struct socket_structure       SOCKET;
  592. #endif 
  593.   struct c_object_structure     C_OBJECT;
  594.   struct weak_wrapper_structure WEAK_WRAPPER;
  595. };
  596.  
  597. #include "system_p.h"
  598.  
  599. #endif /* STRUCTS_H */
  600.  
  601. /* End of structs.h */
  602.